home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / cluster2.zip / SOURCE.ZIP / VERTMENU.BU < prev   
Text File  |  1996-07-06  |  15KB  |  341 lines
  1. $COMPILE UNIT ".\VERTMENU.PBU"
  2. $CODE SEG "SCRNLIB"
  3. $CPU      8086      ' Make compatible with XT systems
  4. $LIB      ALL OFF   ' Turn off all PowerBASIC libraries
  5. $ERROR    ALL OFF   ' Turn off all PowerBASIC error checking
  6. $OPTIMIZE SIZE      ' Optimize for smaller code
  7.  
  8. DEFINT    A-Z       ' Required for all numeric functions, forces PB to not
  9.                     ' include floating point in UNIT (makes it smaller)
  10.  
  11. '+-----------------------------------------------------------------+
  12. '| This component of PB3BOXES is Copyright Nathan C. Durland III   |
  13. '| All rights reserved                                             |
  14. '+-----------------------------------------------------------------+
  15.  
  16. $INCLUDE ".\PB3BOXES.HDR"
  17.  
  18. SUB VerticalMenu(MenuList$(), Choice%, BYVAL DisplayMode%, _
  19.              BYVAL HighAttr%, BYVAL MenuTimer%,  _
  20.              BYVAL ProcTimer%, BYVAL ProcAddr AS DWORD) LOCAL PUBLIC
  21. '╒════════════════════════════════════════════════════════════════════════════╕
  22. '│ This is the routine to call for simple one-choice vertical menus           │
  23. '│                                                                            │
  24. '│ See TagMenu for a more complete definition of the paramters                │
  25. '╘════════════════════════════════════════════════════════════════════════════╛
  26.  
  27.   Junk$ = "ONE"
  28.     CALL TagMenu(MenuList$(), Junk$, DisplayMode%, _
  29.                   HighAttr%,MenuTimer%, ProcTimer%, ProcAddr)
  30.  
  31.   Choice% = INSTR(junk$,"1")
  32.  
  33. END SUB
  34.  
  35.  
  36. SUB TagMenu(MenuList$(), TagList$, BYVAL DisplayMode%, _
  37.             BYVAL HighAttr%, BYVAL MenuTimeOut%, _
  38.             BYVAL ProcTimeOut%, BYVAL ProcAddr AS DWORD) PUBLIC
  39. '╒════════════════════════════════════════════════════════════════════════════╕
  40. '│ This routine will display a list of items -- MenuList$() -- on the screen  │
  41. '│ and will toggle the corresponding element of TagMenuChoice%() from %True   │
  42. '│ to %False, as appropriate.  Each tagged entry will have a "" next to it.  │
  43. '│                                                                            │
  44. '│ The user can toggle the choice of an item by pressing the INS or the       │
  45. '│ DEL key.  CTRL-INS & CTRL-DEL will select/deselect all items.              │
  46. '│                                                                            │
  47. '│ The ENTER key will terminate the call.  ESC also terminates, but will set  │
  48. '│ the ItemsTagged% parameter to 0.                                           │
  49. '│                                                                            │
  50. '│      - The Home Key will move the menu to the top,                         │
  51. '│      - The End  key will proceed to the bottom.                            │
  52. '╞════════════════════════════════════════════════════════════════════════════╡
  53. '│Using TagMenu really involves 3 CALL statements:                            │
  54. '│    1. call MakeBox to create a box to place the menu in.  Make sure the      │
  55. '│     box is at least 4 characters wider than the widest menu list item.     │
  56. '│    2. call TagMenu.                                                          │
  57. '│    3. call RemoveBox.                                                        │
  58. '╞════════════════════════════════════════════════════════════════════════════╡
  59. '│PowerBASIC calling parameters:                                              │
  60. '│                                                                            │
  61. '│  MenuList$()   --  the items to display on the screen. The last element in │
  62. '│                    the array must be set to ""                             │
  63. '│  TagList$      --  A string of "0" and "1", with a lenght equal to the     │
  64. '│                    number of items in the menu.  "1" corresponds to a      │
  65. '│                    tagged item.  If this string is eqal to "ONE" when this │
  66. '│                    routine is called, then the user will only be allowed   │
  67. '│                    to make one choice.                                     │
  68. '│  DisplayMode%  --  if 0, then the choices are centered in the box.         │
  69. '│                --  if 1, the choices are left justified                    │
  70. '│                --  if 2, the choices are left justified, and have a        │
  71. '│                    letter next to them.  Pressing the letter highlights    │
  72. '│                    that choice. The letters are based on the items position│
  73. '│                    in the menu screen                                      │
  74. '│  HighAttr%     --  The color attribute to use for highlighted items        │
  75. '│  MenuTimeOut%  --  a timeout value (seconds).  If no choice is made before │
  76. '│                    this runs out, the menu exits and returns Choice% = 0.  │
  77. '│                    Set MenuTimer% to 0 for no time out.  A message is      │
  78. '│                    displayed on the bottom of the screen.                  │
  79. '│  ProcTimeOut%  --  Another timer.  This counts how long before the routine │
  80. '│                    pointed to by ProcAddr should be called.  Set it to 0   │
  81. '│                    for no timed routine.  Handy for print spoolers, etc    │
  82. '│  ProcAddr      --  A DWORD value returned by CODEPTR32 that points to a    │
  83. '│                    routine that you'd like done every ProcTimeOut% seconds │
  84. '╘════════════════════════════════════════════════════════════════════════════╛
  85.  
  86.  
  87. JustOne%  = (TagList$ = "ONE")
  88. MenuRow%  = BoxParms%(CurrentBox%,1)    ' Get current box size & paramters
  89. MenuCol%  = BoxParms%(CurrentBox%,2)
  90. MenuRows% = BoxParms%(CurrentBox%,3)
  91. MenuCols% = BoxParms%(CurrentBox%,4)
  92. MenuAttr% = BoxParms%(CurrentBox%,5)
  93.  
  94. '╒════════════════════════════════════════════════════════════════╕
  95. '│ We're might have to change these, so we want to save them now  │
  96. '╘════════════════════════════════════════════════════════════════╛
  97. OldMenuCol%   = MenuCol%
  98. OldMenuRows%  = MenuRows%
  99. OldMenuCols%  = MenuCols%
  100.  
  101. IF BoxParms%(CurrentBox%,6) > 0 THEN    ' Account for the border
  102.   INCR MenuRow%,1
  103.   DECR MenuRows%,2
  104.   INCR MenuCol%,1
  105.   DECR MenuCols%,2
  106. END IF
  107.  
  108. MenuLen% = MenuRows%                        ' set some other vars that we need
  109. ARRAY SCAN MenuList$(1), = "", TO ItemCnt%
  110. IF ItemCnt% = 0 THEN
  111.   ItemCnt% = UBOUND(MenuList$())
  112. ELSE
  113.   DECR ItemCnt%,1
  114. END IF
  115.  
  116. IF ItemCnt% < MenuLen% THEN
  117.   MenuLen% = ItemCnt%
  118.   MenuRows% = ItemCnt%
  119.   BoxParams%(CurrentBox%,3) = ItemCnt% + 2  ' set this so that only the area
  120. END IF                                      ' with menu items on it scrolls
  121.  
  122. IF DisplayMode% = 2 THEN                    ' put the letters in place for
  123.   FOR x% = 1 TO MenuLen%                    ' the menu
  124.     CALL PrtBox(x%,1,CHR$(64+x%,32),HighAttr%)
  125.   NEXT x%
  126.   BoxParms%(CurrentBox%,2) = MenuCol% + 1
  127.   BoxParms%(CurrentBox%,4) = MenuCol% - 1  ' change this so letters don't
  128.   MenuCol% = MenuCol% + 2                   ' scroll with box
  129.   MenuCols% = MenuCols% - 2
  130. END IF
  131.  
  132. TagList$ = TagList$ + STRING$(ItemCnt%,"0")
  133. TagList$ = LEFT$(TagList$,ItemCnt%)
  134.  
  135. ItemPtr% = 1                          'Array member currently pointed to
  136. curntpos% = 1                          'Position in the on-screen menu
  137. TheCnt% = ItemsTagged%
  138. TopItem% = 1
  139. BottomItem% = MenuLen%
  140.  
  141. GOSUB FillTagMenu
  142. MenuTimer! = -1
  143. ProcTimer! = -1
  144. IF MenuTimeOut% > 0 THEN MenuTimer! = TIMER + MenuTimeOut%
  145. IF ProcTimeOut% > 0 THEN ProcTimer! = TIMER + ProcTimeOut%
  146. Terminated% = %False
  147. WHILE NOT Terminated%
  148.  
  149. ' Highlight the current item
  150.   CALL QATTR((MenuRow%+curntPos%-1), MenuCol%,1, MenuCols%, HighAttr%)
  151.  
  152. ' Get a keypress from the user, and do other stuff while we are waiting
  153.     WHILE NOT INSTAT
  154.     IF (MenuTimer! > 0) AND (TIMER > MenuTimer!) THEN
  155.       TagList$ = STRING$(ItemCnt%,"0")
  156.       EXIT SUB
  157.     END IF
  158.  
  159.     IF (ProcTimer! > 0) AND (TIMER > ProcTimer!) THEN
  160.       CALL DWORD ProcAddr
  161.       ProcTimer! = TIMER + ProcTimeOut%
  162.     END IF
  163.   WEND
  164.  
  165.   a$ = INKEY$                             ' get the key, then
  166.   IF LEN(a$) = 1 THEN                     ' assign the ascii value to
  167.     ans% = ASC(UCASE$(a$))                ' our response.
  168.   ELSE                                    ' for two byte keys, re